      SUBROUTINE POLISH ( TOKE, NTOKE, FACTS, ERR )
C*
C*                  *******************************
C*                  *******************************
C*                  **                           **
C*                  **           POLISH          **
C*                  **                           **
C*                  *******************************
C*                  *******************************
C*
C*     SUBPROGRAM :
C*          POLISH NOTATION CONVERSION
C*
C*     AUTHOR :
C*          ART RAGOSTA
C*          MS 207-5
C*          AMES RESEARCH CENTER
C*          MOFFETT FIELD, CALIF   94035
C*          (415) 694-5578
C*
C*     PURPOSE :
C*          TO REPLACE THE UNITS ARRAY (WHICH IS IN ALGEBRAIC
C*          NOTATION) WITH THE EQUIVALENT REVERSE POLISH STRING.
C*
C*     METHODOLOGY :
C*          USE THE STACK COMPILATION TECHNIQUE, REFERENCE:
C*          KATZAN, "ADVANCED PROGRAMMING", VAN NOSTRAND REINHOLD CO,
C*          NEW YORK, 1970.
C*
C*     INPUT ARGUMENTS :
C*          TOKE  - THE LIST OF TOKENS IN ALGEBRAIC FORM
C*          NTOKE - THE NUMBER OF ELEMENTS IN 'TOKE'
C*
C*     OUTPUT ARGUMENTS :
C*          TOKE  - THE NEW LIST IN REVERSE POLISH FORM
C*          NTOKE - THE NUMBER OF ELEMENTS IN 'TOKE'
C*          ERR   - SET TRUE FOR UNMATCHED PARENTHESES.
C*
C*     INTERNAL WORK AREAS :
C*          ISTACK, STACK - TEMPORARY OPERATOR STACKS
C*
C*     COMMON BLOCKS :
C*          NONE
C*
C*     FILE REFERENCES :
C*          NONE
C*
C*     SUBPROGRAM REFERENCES :
C*          NONE
C*
C*     ERROR PROCESSING :
C*          CHECK EACH RIGHT PAREN FOR A MATCHING LEFT PAREN
C*
C*     TRANSPORTABILITY LIMITATIONS :
C*          SUBPROGRAM NAME IS LONGER THAN 6 CHARACTERS
C*
C*     ASSUMPTIONS AND RESTRICTIONS :
C*          NONE
C*
C*     LANGUAGE AND COMPILER :
C*          ANSI FORTRAN 77
C*
C*     VERSION AND DATE :
C*          VERSION I.0      7-FEB-85
C*
C*     CHANGE HISTORY :
C*           7-FEB-85    INITIAL VERSION
C*
C***********************************************************************
C*
      CHARACTER *6 TOKE(1), STACK(20)
      DOUBLE PRECISION FACTS(1), FSTACK(20)
      DIMENSION ISTACK(20)
      LOGICAL ERR
C
      ISP   = 1
      IPOLE = 0
      ISTACK ( ISP ) = -1
      STACK ( ISP )  = ' '
      FSTACK ( ISP ) = 0.D0
C
C --- ALL TOKENS
C
      DO 100 I = 1, NTOKE
C
C ----- '(' STACK IT ONLY
C
         IF (TOKE(I) .EQ. '(') THEN
            ISP = ISP + 1
            STACK(ISP)  = TOKE(I)
            ISTACK(ISP) = 0
            FSTACK(ISP) = FACTS(I)
C
C ----- ')' UNSTACK UNTIL MATCHING '(' IS FOUND
C
         ELSE IF (TOKE(I) .EQ. ')') THEN
20          IF (ISTACK(ISP) .NE. 0) THEN
               IPOLE = IPOLE + 1
               TOKE(IPOLE)  = STACK(ISP)
               FACTS(IPOLE) = FSTACK(ISP)
               ISP = ISP - 1
               IF (IPOLE .LE. 0) THEN
                  ERR = .TRUE.
                  RETURN
               ENDIF
               GO TO 20
            ENDIF
            ISP = ISP - 1
C
C ----- '*' OR '/' ... UNSTACK ANY '^', '*', OR '/' ON THE STACK
C
         ELSE IF ((TOKE(I) .EQ. '*') .OR.
     $            (TOKE(I) .EQ. '/')) THEN
30          IF (ISTACK(ISP) .GE. 8) THEN
               IPOLE = IPOLE + 1
               TOKE(IPOLE)  = STACK(ISP)
               FACTS(IPOLE) = FSTACK(ISP)
               ISP = ISP - 1
               GO TO 30
            ENDIF
            ISP = ISP + 1
            STACK(ISP)  = TOKE(I)
            FSTACK(ISP) = FACTS(I)
            ISTACK(ISP) = 8
C
C ----- '^' ... UNSTACK ANY '^' ON THE STACK
C
         ELSE IF (TOKE(I) .EQ. '^') THEN
40          IF (ISTACK(ISP) .GE. 9) THEN
               IPOLE = IPOLE + 1
               TOKE(IPOLE)  = STACK(ISP)
               FACTS(IPOLE) = FSTACK(ISP)
               ISP = ISP - 1
               GO TO 40
            ENDIF
            ISP = ISP + 1
            STACK(ISP)  = TOKE(I)
            FSTACK(ISP) = FACTS(I)
            ISTACK(ISP) = 9
C
C ----- UNITS AND EXPONENTS GET MOVED DIRECTLY TO OUTPUT
C
         ELSE
            IPOLE = IPOLE + 1
            TOKE(IPOLE)  = TOKE(I)
            FACTS(IPOLE) = FACTS(I)
         ENDIF
100      CONTINUE
      NTOKE = IPOLE
C
C --- THERE MAY STILL BE OPERATORS ON THE STACK... UNSTACK THEM
C
300   IF (ISP .GT. 1) THEN
         NTOKE = NTOKE + 1
         TOKE(NTOKE) = STACK(ISP)
         FACTS(NTOKE)= FSTACK(ISP)
         ISP = ISP - 1
         GO TO 300
      ENDIF
      RETURN
      END
C
C---END POLISH
C
